;;; Mudsync --- Live hackable MUD
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of Mudsync.
;;;
;;; Mudsync is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Mudsync is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.

(define-module (mudsync player)
  #:use-module (mudsync command)
  #:use-module (mudsync gameobj)
  #:use-module (mudsync game-master)
  #:use-module (mudsync parser)
  #:use-module (8sync actors)
  #:use-module (8sync agenda)
  #:use-module (ice-9 control)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:export (<player>
            player-self-commands))

;;; Players
;;; =======

(define player-self-commands
  (list
   (empty-command "inventory" 'cmd-inventory)
   ;; aliases...
   ;; @@: Should use an "alias" system for common aliases?
   (empty-command "inv" 'cmd-inventory)
   (empty-command "i" 'cmd-inventory)))

(define-class <player> (<gameobj>)
  (username #:init-keyword #:username
            #:getter player-username)

  (self-commands #:init-value player-self-commands)

  (actions #:allocation #:each-subclass
           #:init-value
           (build-actions
            (init player-init)
            (handle-input player-handle-input)
            (tell player-tell)
            (disconnect-self-destruct player-disconnect-self-destruct)
            (cmd-inventory player-cmd-inventory))))


;;; player message handlers

(define (player-init player message)
  ;; Look around the room we're in
  (<- (gameobj-loc player) 'look-room))


(define* (player-handle-input player message #:key input)
  (define split-input (split-verb-and-rest input))
  (define input-verb (car split-input))
  (define input-rest (cdr split-input))

  (define command-candidates
    (player-gather-command-handlers player input-verb))

  (define winner
    (find-command-winner command-candidates input-rest))

  (match winner
    ((cmd-action winner-id message-args)
     (apply <- winner-id cmd-action message-args))
    (#f
     (<- (gameobj-gm player) 'write-home
         #:text "Huh?\n"))))

(define* (player-tell player message #:key text)
  (<- (gameobj-gm player) 'write-home
      #:text text))

(define (player-disconnect-self-destruct player message)
  "Action routine for being told to disconnect and self destruct."
  (define loc (gameobj-loc player))
  (when loc
    (<- loc 'tell-room
        #:exclude (actor-id player)
        #:text (format #f "~a disappears in a puff of entropy!\n"
                       (slot-ref player 'name))))
  (gameobj-self-destruct player))

(define (player-cmd-inventory player message)
  "Display the inventory for the player"
  (define inv-names
    (map
     (lambda (inv-item)
       (mbody-val (<-wait inv-item 'get-name)))
     (gameobj-occupants player)))
  (define text-to-show
    (if (eq? inv-names '())
        "You aren't carrying anything.\n"
        (apply string-append
               "You are carrying:\n"
               (map (lambda (item-name)
                      (string-append "  * " item-name "\n"))
                    inv-names))))
  (<- (actor-id player) 'tell #:text text-to-show))


;;; Command handling
;;; ================

;; @@: Hard to know whether this should be in player.scm or here...
;; @@: This could be more efficient as a stream...!?
(define (player-gather-command-handlers player verb)
  (define player-loc
    (let ((result (gameobj-loc player)))
      (if result
          result
          (throw 'player-has-no-location
                 "Player ~a has no location!  How'd that happen?\n"
                 #:player-id (actor-id player)))))

  ;; Ask the room for its commands
  (define room-commands
    ;; TODO: Map room id and sort
    (mbody-receive (_ #:key commands)
        (<-wait player-loc 'get-container-commands
                #:verb verb)
      commands))

  ;; All the co-occupants of the room (not including ourself)
  (define co-occupants
    (remove
     (lambda (x) (equal? x (actor-id player)))
     (mbody-receive (_ #:key occupants)
         (<-wait player-loc 'get-occupants)
       occupants)))

  ;; @@: There's a race condition here if someone leaves the room
  ;;   during this, heh...
  ;;   I'm not sure it can be solved, but "lag" on the race can be
  ;;   reduced maybe?

  ;; Get all the co-occupants' commands
  (define co-occupant-commands
    (fold
     (lambda (co-occupant prev)
       (mbody-receive (_ #:key commands goes-by)
           (<-wait co-occupant 'get-commands
                   #:verb verb)
         (append
          (map (lambda (command)
                 (list command goes-by co-occupant))
               commands)
          prev)))
     '()
     co-occupants))

  ;; Append our own command handlers
  (define our-commands
    (filter
     (lambda (cmd)
       (equal? (command-verbs cmd) verb))
     (val-or-run
      (slot-ref player 'self-commands))))

  ;; Append our inventory's relevant command handlers
  (define inv-items
    (gameobj-occupants player))
  (define inv-item-commands
    (fold
     (lambda (inv-item prev)
       (mbody-receive (_ #:key commands goes-by)
           (<-wait inv-item 'get-contained-commands
                   #:verb verb)
         (append
          (map (lambda (command)
                 (list command goes-by inv-item))
               commands)
          prev)))
     '()
     inv-items))

  ;; Now return a big ol sorted list of ((actor-id . command))
  (append
   (sort-commands-append-actor room-commands
                               player-loc '()) ; room doesn't go by anything
   (sort-commands-multi-actors co-occupant-commands)
   (sort-commands-append-actor our-commands
                               (actor-id player) '()) ; nor does player
   (sort-commands-multi-actors inv-item-commands)))

(define (sort-commands-append-actor commands actor-id goes-by)
  (sort-commands-multi-actors
   (map (lambda (command) (list command goes-by actor-id)) commands)))

(define (sort-commands-multi-actors actors-and-commands)
  (sort
   actors-and-commands
   (lambda (x y)
     (> (command-priority (car x))
        (command-priority (car y))))))


(define (find-command-winner sorted-candidates line)
  "Find a command winner from a sorted list of candidates"
  ;; A cache of results from matchers we've already seen
  ;; TODO: fill in this cache.  This is a *critical* optimization!
  (define matcher-cache '())
  (call/ec
   (lambda (return)
     (for-each
      (match-lambda
        ((command actor-goes-by actor-id)
         (let* ((matcher (command-matcher command))
                (matched (matcher line)))
           (if (and matched
                    ;; Great, it matched, but does it also pass
                    ;; should-handle?
                    (apply (command-should-handle command)
                           actor-goes-by
                           matched))  ; matched is kwargs if truthy
               (return (list (command-action command)
                             actor-id matched))
               #f))))
      sorted-candidates)
     #f)))
